\ fpround 01.5.15 JCF
\ An adjunct to NewFloatMgr.
\ Version that works around PalmOS
\ bug.

needs NewFloatMgr
needs case

BASE @ DECIMAL
HEX

:NONAME \ round and return lsb
    D>SF DROP 1 AND ;

:NONAME \ these are hex!
      -2000003. [ OVER COMPILE, ]
      -2000006. [ OVER COMPILE, ]
      -2000002. [ OVER COMPILE, ]
      -2000001. [ OVER COMPILE, ]
       2000001. [ OVER COMPILE, ]
       2000002. [ OVER COMPILE, ]
       2000006. [ OVER COMPILE, ]
       2000003. [ SWAP COMPILE, ]
    0 8 for 2* OR next ;

: _cur_round ( -- mode )
    [ SWAP COMPILE, ] CASE
        81 OF flpToNearest ENDOF
            42 OF flpTowardZero ENDOF
        4D OF flpDownward ENDOF
        B2 OF flpUpward ENDOF
        -55 THROW
    ENDCASE ;

: _fp_round ( want. -- got. )
    DROP DUP
    _cur_round = IF 0 EXIT THEN
    DUP 0 flpem0 2DROP
    DUP _cur_round DUP >R
    = IF R> DROP 0 EXIT THEN
    029A. @a
    30 AND 4 RSHIFT
    R@ <> IF DROP R> 0 EXIT THEN
    R> DROP
    4 LSHIFT 30 AND
    029A. @a
    30 INVERT AND
    OR
    029A. !a
    _cur_round 0 ;

BASE !
